home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / virtmem.exe / MEMMOVER.BAK < prev    next >
Text File  |  1991-07-25  |  6KB  |  266 lines
  1. Unit MemMOver;
  2. {$O+}
  3. {Unit that overrides (overloads) basic memory management routines used by
  4.  units Pull, Wndw, and Qwik, to allow PRICE86 more control over the heap.}
  5.  
  6. Interface
  7.  
  8. Type
  9.  
  10.      ST4=String[4];
  11.      ST9=String[9];
  12.  
  13.      PointerTractPtr=^PointerTractRec;
  14.  
  15.      PointerTractRec=
  16.         Record
  17.           PhysicalPoint:Pointer;
  18.           VirtualPoint :LongInt;
  19.           Size         :Word;
  20.           Next         :LongInt{PointerTractRec};
  21.         End;
  22.  
  23. Var
  24.  
  25.      PointerTract:LongInt{PointerTractPtr};
  26.  
  27. Procedure New     (var P:Pointer);
  28. Procedure Dispose (var P:Pointer);
  29. Procedure Mark    (var P:Pointer);
  30. Procedure Release (var P:Pointer);
  31. Procedure GetMem  (var P        ; Size:Word);
  32. Procedure FreeMem (var P        ;Size:Word);
  33. Function  MaxAvail:LongInt;
  34. Function  MemAvail:LongInt;
  35.  
  36. Procedure InitPseudoHeap;
  37.  
  38. Function PointerString(CoolPoint:Pointer):ST9;
  39. Function PointerTractPtrR(Virt : LongInt; Mucky : Integer):PointerTractPtr;
  40.  
  41. {*****************************************************************************}
  42. Implementation
  43.  
  44. Uses VirtuMem,ErrorEra;
  45.  
  46. {--------------------}
  47. Function PointerTractPtrR(Virt : LongInt; Mucky : Integer):PointerTractPtr;
  48.  
  49. Var Temp:PointerTractPtr;
  50.  
  51. BEGIN
  52.  
  53.      Temp:=PointerTractPtr(R(Virt,Mucky));
  54.      PointerTractPtrR:=Temp;
  55.  
  56. END;
  57. {--------------------}
  58. {Hex_String}
  59. { The function Hex_String converts an Word into a four
  60.   character hexadecimal number(string) with leading zeroes.   }
  61. Function Hex_String(Number: Word): ST4;
  62. Function Hex_Char(Number: Word): Char;
  63.   Begin
  64.     If Number<10 then
  65.          Hex_Char:=Char(Number+48)
  66.     else
  67.          Hex_Char:=Char(Number+55);
  68.   end; { Function Hex_Char }
  69.  
  70.   Var
  71.     S: ST4;
  72.   Begin
  73.     S:='';
  74.     S:=Hex_Char( (Number shr 1) div 2048);
  75.     Number:=( ((Number shr 1) mod 2048) shl 1)+
  76.             (Number and 1) ;
  77.     S:=S+Hex_Char(Number div 256);
  78.     Number:=Number mod 256;
  79.     S:=S+Hex_Char(Number div 16);
  80.     Number:=Number mod 16;
  81.     S:=S+Hex_Char(Number);
  82.     Hex_String:=S+'h';
  83.   end; { Function Hex_String }
  84. {---------------------}
  85. {PointerString}
  86. {Converts a pointer to a 9 character string for display purposes.}
  87. Function PointerString(CoolPoint:Pointer):ST9;
  88.  
  89. BEGIN
  90.  
  91.    PointerString:=Hex_String(Seg(CoolPoint^))+':'+Hex_String(Ofs(CoolPoint^));
  92.  
  93. END;
  94. {--------------------}
  95. Procedure New     (var P:Pointer);
  96.  
  97. BEGIN
  98.  
  99.   ErrOut(UMemMOver,0,'New');
  100.  
  101. END;
  102. {--------------------}
  103. Procedure Dispose (var P:Pointer);
  104.  
  105. BEGIN
  106.  
  107.   ErrOut(UMemMOver,0,'Dispose');
  108.  
  109. END;
  110. {--------------------}
  111. Procedure Mark    (var P:Pointer);
  112.  
  113. BEGIN
  114.  
  115.   ErrOut(UMemMOver,0,'Mark');
  116.  
  117. END;
  118. {--------------------}
  119. Procedure Release (var P:Pointer);
  120.  
  121. BEGIN
  122.  
  123.   ErrOut(UMemMOver,0,'Release');
  124.  
  125. END;
  126. {--------------------}
  127. {Track}
  128. {Inserts a record to keep track of the virtual pointer corresponding to the
  129.  physical one.  Uses PointerTract as a global.}
  130. Procedure Track(VirtuPointer:LongInt;
  131.                 PhysiPointer:Pointer;
  132.                 Bigness     :Word);
  133.  
  134. Var
  135.  
  136.      NewOne:LongInt;
  137.  
  138. BEGIN
  139.  
  140.   NewOne:=ANew(SizeOf(PointerTractRec));
  141.   With PointerTractPtrR(NewOne,Stay)^ do
  142.      Begin
  143.        VirtualPoint:=VirtuPointer;
  144.        PhysicalPoint:=PhysiPointer;
  145.        Size:=Bigness;
  146.        Next:=PointerTract;
  147.      End;
  148.   Unstay(NewOne);
  149.   PointerTract:=NewOne;
  150.  
  151. END;
  152. {--------------------}
  153. {FindStat}
  154. {This function returns the record containing the virtual pointer (and other
  155.  info) that coresponds to the physical pointer input parameter.  Use
  156.  PointerTract global.  Returns Null if not found.}
  157. Function FindStat(P:Pointer):LongInt{PointerTractPtr};
  158.  
  159. Var
  160.  
  161.      Current:LongInt{PointerTractPtr};
  162.  
  163. BEGIN
  164.  
  165.   Current:=PointerTract;
  166.   While (Current<>Null) and
  167.     (PointerTractPtrR(Current,Clen)^.PhysicalPoint<>P) do
  168.        Current:=PointerTractPtrR(Current,Clen)^.Next;
  169.   FindStat:=Current;
  170.  
  171. END;
  172. {--------------------}
  173. {Untrack}
  174. {Deletes the record that keeps track of the block with VirtuPoint being
  175.  the virtual pointer.  Depossess the block.  Block is assumed to exist.
  176.  PointerTract used globally.}
  177. Procedure Untrack(VirtuPoint:LongInt);
  178.  
  179. Var
  180.  
  181.      Current :LongInt{PointerTractPtr};
  182.      Previous:LongInt{PointerTractPtr};
  183.  
  184. BEGIN
  185.  
  186.   Previous:=Null;
  187.   Current:=PointerTract;
  188.   While (Current<>Null) and
  189.     (PointerTractPtrR(Current,Clen)^.VirtualPoint<>VirtuPoint) do
  190.      Begin
  191.        Previous:=Current;
  192.        Current:=PointerTractPtrR(Current,Clen)^.Next;
  193.      End;
  194.   If (Previous=Null) then
  195.        PointerTract:=PointerTractPtrR(Current,Clen)^.Next
  196.   Else
  197.        PointerTractPtrR(Previous,Dirt)^.Next:=PointerTractPtrR(Current,Clen)^.
  198.          Next;
  199.   Depossess(Current,SizeOf(PointerTractRec));
  200.  
  201. END;
  202. {--------------------}
  203. {GetMem}
  204. Procedure GetMem  (var P        ; Size:Word);
  205.  
  206. Var
  207.  
  208.      VirtuPointer:LongInt;
  209.  
  210. BEGIN
  211.  
  212.   VirtuPointer:=ANew(Size);
  213.   Pointer(P):=R(VirtuPointer,Stay);
  214.   Track(VirtuPointer,Pointer(P),Size);
  215.  
  216. END;
  217. {--------------------}
  218. {FreeMem}
  219. Procedure FreeMem (var P        ;Size:Word);
  220.  
  221. Var
  222.  
  223.      PointerStat:LongInt{PointerTractPtr};
  224.  
  225. BEGIN
  226.  
  227.   PointerStat:=FindStat(Pointer(P));
  228.   If (PointerStat=Null) then
  229.       ErrOut(UMemMOver,4,'');
  230.   If (PointerTractPtrR(PointerStat,Clen)^.Size<>Size) then
  231.       ErrOut(UMemMOver,5,'');
  232.   With PointerTractPtrR(PointerStat,Stay)^ do
  233.      Begin
  234.        Unstay(VirtualPoint);
  235.        Depossess(VirtualPoint,Size);
  236.        Untrack(VirtualPoint);
  237.      End;
  238.   Unstay(PointerStat);
  239.  
  240. END;
  241. {--------------------}
  242. Function  MaxAvail:LongInt;
  243.  
  244. BEGIN
  245.  
  246.   MaxAvail:=PageSize;
  247.  
  248. END;
  249. {--------------------}
  250. Function  MemAvail:LongInt;
  251.  
  252. BEGIN
  253.  
  254.   MemAvail:=PageSize;
  255.  
  256. END;
  257. {---------------------}
  258. Procedure InitPseudoHeap;
  259.  
  260. BEGIN
  261.  
  262.   PointerTract:=Null;
  263.  
  264. END;
  265. {--------------------}
  266. END.